home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tptc16.zip / TPCSYM.INC < prev    next >
Text File  |  1993-01-04  |  4KB  |  194 lines
  1.  
  2. (*
  3.  * TPTC - Turbo Pascal to C translator
  4.  *
  5.  * (C) 1988 Samuel H. Smith (rev. 13-Feb-88)
  6.  *
  7.  *)
  8.  
  9. function findsym( table: symptr;
  10.                   id:    string40): symptr;
  11.    {locate a symbol in a specified symbol table.  returns pointer to
  12.     the entry if found, otherwise nil is returned}
  13. var
  14.    sym: symptr;
  15.  
  16. begin
  17.    stoupper(id);
  18.    past_marker := false;
  19.  
  20.    sym := table;
  21.    while sym <> nil do
  22.    begin
  23.       if sym^.id = id then
  24.       begin
  25.          findsym := sym;    {symbol found}
  26.          exit;
  27.       end;
  28.       if sym^.id = localseprt then
  29.          past_marker := true;
  30.       sym := sym^.next;
  31.    end;
  32.  
  33.    findsym := nil;   {symbol not found}
  34. end;
  35.  
  36.  
  37. function locatesym(id:    string40): symptr;
  38.    {locate a symbol in either the local or the global symbol table.
  39.     returns the symbol table entry pointer, if found.  returns
  40.     nil when not in either table}
  41. var
  42.    sym: symptr;
  43.  
  44. begin
  45.    in_globals := false;
  46.    in_locals := false;
  47.    sym := findsym(locals,id);
  48.    if sym <> nil then
  49.       in_locals := true
  50.    else
  51.    begin
  52.       sym := findsym(globals,id);
  53.       if sym <> nil then
  54.          in_globals := true
  55.    end;
  56.  
  57.    locatesym := sym;
  58. end;
  59.  
  60.  
  61. procedure addsym( var table: symptr;
  62.                   id:        string40;
  63.                   symtype:   symtypes;
  64.                   suptype:   supertypes;
  65.                   parcount:  integer;
  66.                   vv:       integer;
  67.                   lim:      integer);
  68.    {add a symbol to a specific symbol table.
  69.     does not add(or change) the symbol if a duplicate entry is found}
  70. var
  71.    sym: symptr;
  72.  
  73. begin
  74.    sym := nil;
  75.  
  76.    if unitlevel = 0 then
  77.       sym := findsym( table,id );
  78.  
  79.    if sym = nil then
  80.    begin
  81.       if maxavail-300 > sizeof(sym^) then
  82.       begin
  83.          new(sym);
  84.          stoupper(id);
  85.          sym^.id := id;
  86.          sym^.symtype := symtype;
  87.          sym^.suptype := suptype;
  88.          sym^.parcount := parcount;
  89.          sym^.limit := lim;
  90.          sym^.pvar := vv;
  91.          sym^.parent := nil;
  92.          sym^.next := table;
  93.          table := sym;
  94.  
  95.    {writeln('  add id=',id,' type=',ord(symtype),' par=',parcount);}
  96.       end
  97.       else
  98.  
  99.       begin
  100.          write(con, ^G^G^G,'TPTC: Out of memory');
  101.          halt;
  102.       end;
  103.    end;
  104.  
  105. end;
  106.  
  107.  
  108. procedure newsym( id:       string40;
  109.                   symtype:  symtypes;
  110.                   suptype:  supertypes;
  111.                   parcount: integer;
  112.                   vv:       integer;
  113.                   lim:      integer);
  114.    {enter a new symbol into the current symbol table (local or global)}
  115. begin
  116.    if unitlevel = 0 then
  117.       addsym(globals,id,symtype,suptype,parcount,vv,lim)
  118.    else
  119.       addsym(locals,id,symtype,suptype,parcount,vv,lim);
  120. end;
  121.  
  122.  
  123. procedure purgetable( var table: symptr );
  124.    {purge all entries from the specified symbol table}
  125. var
  126.    sym: symptr;
  127.    sn:  integer;
  128. begin
  129.  
  130.    if dumpsymbols then
  131.    begin
  132.       writeln(ofd[level]);
  133.       writeln(ofd[level],'  /* Symbol table:');
  134.  
  135.       sym := table; sn := 0;
  136.       while sym <> nil do
  137.       begin
  138.          if (sn mod 20) = 0 then
  139.             writeln(ofd[level],
  140.               ' *',^M^J,' *    ',
  141.               ljust('Name',identlen),
  142.               'Par Supertype      Type           Limit',^M^J,
  143.               ' *    ------------------------------------------------------');
  144.  
  145.          writeln(ofd[level],' *    ',
  146.               LJUST(sym^.id,identlen), sym^.parcount:3,' ',
  147.               LJUST(supertypename[sym^.suptype],15),
  148.               LJUST(typename[sym^.symtype],15),
  149.               sym^.limit);
  150.  
  151.          sym := sym^.next;
  152.          inc(sn);
  153.       end;
  154.  
  155.       writeln(ofd[level],' */');
  156.       writeln(ofd[level]);
  157.       writeln(ofd[level]);
  158.    end;
  159.  
  160.  
  161.    while table <> nil do
  162.    begin
  163.       sym := table;
  164.       table := table^.next;
  165.       dispose(sym);
  166.    end;
  167.  
  168. end;
  169.  
  170.  
  171. procedure purgefrom(idn: string40);
  172.    {purge all entries from local symbol table starting with spec'd symbol}
  173. var
  174.    sym: symptr;
  175. begin
  176. (* writeln(^M^J,'purge from ',idn);*)
  177.  
  178.    while locals <> nil do
  179.    begin
  180.       sym := locals;
  181.       if locals^.id <> idn then
  182.       begin
  183.          locals := locals^.next;
  184.          if locals <> nil then
  185.             locals^.parent := nil;
  186. (*       writeln('dispose of local: ',sym^.id);*)
  187.          dispose(sym);
  188.       end
  189.       else
  190.          exit;
  191.    end;
  192. end;
  193.  
  194.